home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / Tcl 6.2 / tclParse.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-12  |  32.1 KB  |  1,186 lines
  1. /* 
  2.  * tclParse.c --
  3.  *
  4.  *    This file contains a collection of procedures that are used
  5.  *    to parse Tcl commands or parts of commands (like quoted
  6.  *    strings or nested sub-commands).
  7.  *
  8.  * Copyright 1991 Regents of the University of California.
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appear in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #ifndef lint
  19. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclParse.c,v 1.20 91/10/31 16:41:52 ouster Exp $ SPRITE (Berkeley)";
  20. #endif
  21.  
  22. #include "tclInt.h"
  23.  
  24. /*
  25.  * The following table assigns a type to each character.  Only types
  26.  * meaningful to Tcl parsing are represented here.  The table indexes
  27.  * all 256 characters, with the negative ones first, then the positive
  28.  * ones.
  29.  */
  30.  
  31. char tclTypeTable[] = {
  32.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  33.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  34.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  35.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  36.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  37.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  38.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  39.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  40.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  41.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  42.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  43.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  44.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  45.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  46.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  47.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  48.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  49.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  50.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  51.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  52.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  53.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  54.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  55.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  56.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  57.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  58.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  59.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  60.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  61.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  62.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  63.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  64. /* Dividing line between positive and negative... */
  65.     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  66.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  67.     TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
  68.     TCL_SPACE,         TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
  69.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  70.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  71.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  72.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  73.     TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
  74.     TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  75.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  76.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  77.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  78.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  79.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
  80.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  81.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  82.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  83.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  84.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  85.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  86.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  87.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
  88.     TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
  89.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  90.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  91.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  92.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  93.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  94.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  95.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
  96.     TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
  97. };
  98.  
  99. #ifdef macintosh
  100. #    pragma segment tclParse
  101. #endif
  102.  
  103. /*
  104.  * Function prototypes for procedures local to this file:
  105.  */
  106.  
  107. static char *    QuoteEnd _ANSI_ARGS_((char *string, int term));
  108. static char *    VarNameEnd _ANSI_ARGS_((char *string));
  109.  
  110. /*
  111.  *----------------------------------------------------------------------
  112.  *
  113.  * Tcl_Backslash --
  114.  *
  115.  *    Figure out how to handle a backslash sequence.
  116.  *
  117.  * Results:
  118.  *    The return value is the character that should be substituted
  119.  *    in place of the backslash sequence that starts at src, or 0
  120.  *    if the backslash sequence should be replace by nothing (e.g.
  121.  *    backslash followed by newline).  If readPtr isn't NULL then
  122.  *    it is filled in with a count of the number of characters in
  123.  *    the backslash sequence.  Note:  if the backslash isn't followed
  124.  *    by characters that are understood here, then the backslash
  125.  *    sequence is only considered to be one character long, and it
  126.  *    is replaced by a backslash char.
  127.  *
  128.  * Side effects:
  129.  *    None.
  130.  *
  131.  *----------------------------------------------------------------------
  132.  */
  133.  
  134. char
  135. Tcl_Backslash(src, readPtr)
  136.     char *src;            /* Points to the backslash character of
  137.                  * a backslash sequence. */
  138.     int *readPtr;        /* Fill in with number of characters read
  139.                  * from src, unless NULL. */
  140. {
  141.     register char *p = src+1;
  142.     char result;
  143.     int count;
  144.  
  145.     count = 2;
  146.  
  147.     switch (*p) {
  148.     case 'b':
  149.         result = '\b';
  150.         break;
  151.     case 'e':
  152.         result = 033;
  153.         break;
  154.     case 'f':
  155.         result = '\f';
  156.         break;
  157.     case 'n':
  158.         result = '\n';
  159.         break;
  160.     case 'r':
  161.         result = '\r';
  162.         break;
  163.     case 't':
  164.         result = '\t';
  165.         break;
  166.     case 'v':
  167.         result = '\v';
  168.         break;
  169.     case 'C':
  170.         p++;
  171.         if (isspace(*p) || (*p == 0)) {
  172.         result = 'C';
  173.         count = 1;
  174.         break;
  175.         }
  176.         count = 3;
  177.         if (*p == 'M') {
  178.         p++;
  179.         if (isspace(*p) || (*p == 0)) {
  180.             result = 'M' & 037;
  181.             break;
  182.         }
  183.         count = 4;
  184.         result = (*p & 037) | 0200;
  185.         break;
  186.         }
  187.         count = 3;
  188.         result = *p & 037;
  189.         break;
  190.     case 'M':
  191.         p++;
  192.         if (isspace(*p) || (*p == 0)) {
  193.         result = 'M';
  194.         count = 1;
  195.         break;
  196.         }
  197.         count = 3;
  198.         result = *p + 0200;
  199.         break;
  200.     case '}':
  201.     case '{':
  202.     case ']':
  203.     case '[':
  204.     case '$':
  205.     case ' ':
  206.     case ';':
  207.     case '"':
  208.     case '\\':
  209.         result = *p;
  210.         break;
  211.     case '\n':
  212.         result = 0;
  213.         break;
  214.     default:
  215.         if (isdigit(*p)) {
  216.         result = *p - '0';
  217.         p++;
  218.         if (!isdigit(*p)) {
  219.             break;
  220.         }
  221.         count = 3;
  222.         result = (result << 3) + (*p - '0');
  223.         p++;
  224.         if (!isdigit(*p)) {
  225.             break;
  226.         }
  227.         count = 4;
  228.         result = (result << 3) + (*p - '0');
  229.         break;
  230.         }
  231.         result = '\\';
  232.         count = 1;
  233.         break;
  234.     }
  235.  
  236.     if (readPtr != NULL) {
  237.     *readPtr = count;
  238.     }
  239.     return result;
  240. }
  241.  
  242. /*
  243.  *--------------------------------------------------------------
  244.  *
  245.  * TclParseQuotes --
  246.  *
  247.  *    This procedure parses a double-quoted string such as a
  248.  *    quoted Tcl command argument or a quoted value in a Tcl
  249.  *    expression.  This procedure is also used to parse array
  250.  *    element names within parentheses, or anything else that
  251.  *    needs all the substitutions that happen in quotes.
  252.  *
  253.  * Results:
  254.  *    The return value is a standard Tcl result, which is
  255.  *    TCL_OK unless there was an error while parsing the
  256.  *    quoted string.  If an error occurs then interp->result
  257.  *    contains a standard error message.  *TermPtr is filled
  258.  *    in with the address of the character just after the
  259.  *    last one successfully processed;  this is usually the
  260.  *    character just after the matching close-quote.  The
  261.  *    fully-substituted contents of the quotes are stored in
  262.  *    standard fashion in *pvPtr, null-terminated with
  263.  *    pvPtr->next pointing to the terminating null character.
  264.  *
  265.  * Side effects:
  266.  *    The buffer space in pvPtr may be enlarged by calling its
  267.  *    expandProc.
  268.  *
  269.  *--------------------------------------------------------------
  270.  */
  271.  
  272. int
  273. TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
  274.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  275.                  * evaluations and error messages. */
  276.     char *string;        /* Character just after opening double-
  277.                  * quote. */
  278.     int termChar;        /* Character that terminates "quoted" string
  279.                  * (usually double-quote, but sometimes
  280.                  * right-paren or something else). */
  281.     int flags;            /* Flags to pass to nested Tcl_Eval calls. */
  282.     char **termPtr;        /* Store address of terminating character
  283.                  * here. */
  284.     ParseValue *pvPtr;        /* Information about where to place
  285.                  * fully-substituted result of parse. */
  286. {
  287.     register char *src, *dst, c;
  288.  
  289.     src = string;
  290.     dst = pvPtr->next;
  291.  
  292.     while (1) {
  293.     if (dst == pvPtr->end) {
  294.         /*
  295.          * Target buffer space is about to run out.  Make more space.
  296.          */
  297.  
  298.         pvPtr->next = dst;
  299.         (*pvPtr->expandProc)(pvPtr, 1);
  300.         dst = pvPtr->next;
  301.     }
  302.  
  303.     c = *src;
  304.     src++;
  305.     if (c == termChar) {
  306.         *dst = '\0';
  307.         pvPtr->next = dst;
  308.         *termPtr = src;
  309.         return TCL_OK;
  310.     } else if (CHAR_TYPE(c) == TCL_NORMAL) {
  311.         copy:
  312.         *dst = c;
  313.         dst++;
  314.         continue;
  315.     } else if (c == '$') {
  316.         int length;
  317.         char *value;
  318.  
  319.         value = Tcl_ParseVar(interp, src-1, termPtr);
  320.         if (value == NULL) {
  321.         return TCL_ERROR;
  322.         }
  323.         src = *termPtr;
  324.         length = strlen(value);
  325.         if ((pvPtr->end - dst) <= length) {
  326.         pvPtr->next = dst;
  327.         (*pvPtr->expandProc)(pvPtr, length);
  328.         dst = pvPtr->next;
  329.         }
  330.         strcpy(dst, value);
  331.         dst += length;
  332.         continue;
  333.     } else if (c == '[') {
  334.         int result;
  335.  
  336.         pvPtr->next = dst;
  337.         result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
  338.         if (result != TCL_OK) {
  339.         return result;
  340.         }
  341.         src = *termPtr;
  342.         dst = pvPtr->next;
  343.         continue;
  344.     } else if (c == '\\') {
  345.         int numRead;
  346.  
  347.         src--;
  348.         *dst = Tcl_Backslash(src, &numRead);
  349.         if (*dst != 0) {
  350.         dst++;
  351.         }
  352.         src += numRead;
  353.         continue;
  354.     } else if (c == '\0') {
  355.         Tcl_ResetResult(interp);
  356.         sprintf(interp->result, "missing %c", termChar);
  357.         *termPtr = string-1;
  358.         return TCL_ERROR;
  359.     } else {
  360.         goto copy;
  361.     }
  362.     }
  363. }
  364.  
  365. /*
  366.  *--------------------------------------------------------------
  367.  *
  368.  * TclParseNestedCmd --
  369.  *
  370.  *    This procedure parses a nested Tcl command between
  371.  *    brackets, returning the result of the command.
  372.  *
  373.  * Results:
  374.  *    The return value is a standard Tcl result, which is
  375.  *    TCL_OK unless there was an error while executing the
  376.  *    nested command.  If an error occurs then interp->result
  377.  *    contains a standard error message.  *TermPtr is filled
  378.  *    in with the address of the character just after the
  379.  *    last one processed;  this is usually the character just
  380.  *    after the matching close-bracket, or the null character
  381.  *    at the end of the string if the close-bracket was missing
  382.  *    (a missing close bracket is an error).  The result returned
  383.  *    by the command is stored in standard fashion in *pvPtr,
  384.  *    null-terminated, with pvPtr->next pointing to the null
  385.  *    character.
  386.  *
  387.  * Side effects:
  388.  *    The storage space at *pvPtr may be expanded.
  389.  *
  390.  *--------------------------------------------------------------
  391.  */
  392.  
  393. int
  394. TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
  395.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  396.                  * evaluations and error messages. */
  397.     char *string;        /* Character just after opening bracket. */
  398.     int flags;            /* Flags to pass to nested Tcl_Eval. */
  399.     char **termPtr;        /* Store address of terminating character
  400.                  * here. */
  401.     register ParseValue *pvPtr;    /* Information about where to place
  402.                  * result of command. */
  403. {
  404.     int result, length, shortfall;
  405.     Interp *iPtr = (Interp *) interp;
  406.  
  407.     result = Tcl_Eval(interp, string, flags | TCL_BRACKET_TERM, termPtr);
  408.     if (result != TCL_OK) {
  409.     /*
  410.      * The increment below results in slightly cleaner message in
  411.      * the errorInfo variable (the close-bracket will appear).
  412.      */
  413.  
  414.     if (**termPtr == ']') {
  415.         *termPtr += 1;
  416.     }
  417.     return result;
  418.     }
  419.     (*termPtr) += 1;
  420.     length = strlen(iPtr->result);
  421.     shortfall = length + 1 - (pvPtr->end - pvPtr->next);
  422.     if (shortfall > 0) {
  423.     (*pvPtr->expandProc)(pvPtr, shortfall);
  424.     }
  425.     strcpy(pvPtr->next, iPtr->result);
  426.     pvPtr->next += length;
  427.     Tcl_FreeResult(iPtr);
  428.     iPtr->result = iPtr->resultSpace;
  429.     iPtr->resultSpace[0] = '\0';
  430.     return TCL_OK;
  431. }
  432.  
  433. /*
  434.  *--------------------------------------------------------------
  435.  *
  436.  * TclParseBraces --
  437.  *
  438.  *    This procedure scans the information between matching
  439.  *    curly braces.
  440.  *
  441.  * Results:
  442.  *    The return value is a standard Tcl result, which is
  443.  *    TCL_OK unless there was an error while parsing string.
  444.  *    If an error occurs then interp->result contains a
  445.  *    standard error message.  *TermPtr is filled
  446.  *    in with the address of the character just after the
  447.  *    last one successfully processed;  this is usually the
  448.  *    character just after the matching close-brace.  The
  449.  *    information between curly braces is stored in standard
  450.  *    fashion in *pvPtr, null-terminated with pvPtr->next
  451.  *    pointing to the terminating null character.
  452.  *
  453.  * Side effects:
  454.  *    The storage space at *pvPtr may be expanded.
  455.  *
  456.  *--------------------------------------------------------------
  457.  */
  458.  
  459. int
  460. TclParseBraces(interp, string, termPtr, pvPtr)
  461.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  462.                  * evaluations and error messages. */
  463.     char *string;        /* Character just after opening bracket. */
  464.     char **termPtr;        /* Store address of terminating character
  465.                  * here. */
  466.     register ParseValue *pvPtr;    /* Information about where to place
  467.                  * result of command. */
  468. {
  469.     int level;
  470.     register char *src, *dst, *end;
  471.     register char c;
  472.  
  473.     src = string;
  474.     dst = pvPtr->next;
  475.     end = pvPtr->end;
  476.     level = 1;
  477.  
  478.     /*
  479.      * Copy the characters one at a time to the result area, stopping
  480.      * when the matching close-brace is found.
  481.      */
  482.  
  483. /*dprintf("BRACE: [0]=x%02X'%c' x%lx -> <%.32s>  ", *src, *src, src, src);*/
  484.  
  485.     while (1) {
  486.         c = *src;
  487.         src++;
  488.         if (dst == end) {
  489.             pvPtr->next = dst;
  490. /*dprintf("BRACE: EXPAND  ", pvPtr->buffer, pvPtr->buffer);*/
  491.             (*pvPtr->expandProc)(pvPtr, 20);
  492.             dst = pvPtr->next;
  493.             end = pvPtr->end;
  494.             }
  495.         *dst = c;
  496.         dst++;
  497.         if (CHAR_TYPE(c) == TCL_NORMAL) {
  498.             continue;
  499.             }
  500.         else if (c == '{') {
  501.             level++;
  502.             }
  503.         else if (c == '}') {
  504.             level--;
  505.             if (level == 0) {
  506.                 dst--;            /* Don't copy the last close brace. */
  507.                 break;
  508.                 }
  509.             }
  510.         else if (c == '\\') {
  511.             int count;
  512.     
  513.             /*
  514.              * Must always squish out backslash-newlines, even when in
  515.              * braces.  This is needed so that this sequence can appear
  516.              * anywhere in a command, such as the middle of an expression.
  517.              */
  518.     
  519.             if (*src == '\n') {
  520.                 dst--;
  521.                 src++;
  522.                 }
  523.             else {
  524.                 (void) Tcl_Backslash(src-1, &count);
  525.                 while (count > 1) {
  526.                     if (dst == end) {
  527.                         pvPtr->next = dst;
  528.                         (*pvPtr->expandProc)(pvPtr, 20);
  529.                         dst = pvPtr->next;
  530.                         end = pvPtr->end;
  531.                         }
  532.                     *dst = *src;
  533.                     dst++;
  534.                     src++;
  535.                     count--;
  536.                     }
  537.                 }
  538.             }
  539.         else if (c == '\0') {
  540.             Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
  541.             *termPtr = string-1;
  542.             return TCL_ERROR;
  543.             }
  544.         }
  545.  
  546.     *dst = '\0';
  547. /*dprintf("BRACE-END: buffer x%lx -> <%.32s>  ", pvPtr->buffer, pvPtr->buffer);*/
  548.     pvPtr->next = dst;
  549.     *termPtr = src;
  550.     return TCL_OK;
  551.     }
  552.  
  553. /*
  554.  *--------------------------------------------------------------
  555.  *
  556.  * TclParseWords --
  557.  *
  558.  *    This procedure parses one or more words from a command
  559.  *    string and creates argv-style pointers to fully-substituted
  560.  *    copies of those words.
  561.  *
  562.  * Results:
  563.  *    The return value is a standard Tcl result.
  564.  *    
  565.  *    *argcPtr is modified to hold a count of the number of words
  566.  *    successfully parsed, which may be 0.  At most maxWords words
  567.  *    will be parsed.  If 0 <= *argcPtr < maxWords then it
  568.  *    means that a command separator was seen.  If *argcPtr
  569.  *    is maxWords then it means that a command separator was
  570.  *    not seen yet.
  571.  *
  572.  *    *TermPtr is filled in with the address of the character
  573.  *    just after the last one successfully processed in the
  574.  *    last word.  This is either the command terminator (if
  575.  *    *argcPtr < maxWords), the character just after the last
  576.  *    one in a word (if *argcPtr is maxWords), or the vicinity
  577.  *    of an error (if the result is not TCL_OK).
  578.  *    
  579.  *    The pointers at *argv are filled in with pointers to the
  580.  *    fully-substituted words, and the actual contents of the
  581.  *    words are copied to the buffer at pvPtr.
  582.  *
  583.  *    If an error occurrs then an error message is left in
  584.  *    interp->result and the information at *argv, *argcPtr,
  585.  *    and *pvPtr may be incomplete.
  586.  *
  587.  * Side effects:
  588.  *    The buffer space in pvPtr may be enlarged by calling its
  589.  *    expandProc.
  590.  *
  591.  *--------------------------------------------------------------
  592.  */
  593.  
  594. int
  595. TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
  596.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  597.                  * evaluations and error messages. */
  598.     char *string;        /* First character of word. */
  599.     int flags;            /* Flags to control parsing (same values as
  600.                  * passed to Tcl_Eval). */
  601.     int maxWords;        /* Maximum number of words to parse. */
  602.     char **termPtr;        /* Store address of terminating character
  603.                  * here. */
  604.     int *argcPtr;        /* Filled in with actual number of words
  605.                  * parsed. */
  606.     char **argv;        /* Store addresses of individual words here. */
  607.     register ParseValue *pvPtr;    /* Information about where to place
  608.                  * fully-substituted word. */
  609. {
  610.     register char *src, *dst;
  611.     register char c;
  612.     int type, result, argc;
  613.     char *oldBuffer;        /* Used to detect when pvPtr's buffer gets
  614.                  * reallocated, so we can adjust all of the
  615.                  * argv pointers. */
  616.  
  617.     src = string;
  618.     oldBuffer = pvPtr->buffer;
  619.     dst = pvPtr->next;
  620.     for (argc = 0; argc < maxWords; argc++) {
  621.     argv[argc] = dst;
  622.  
  623.     /*
  624.      * Skip leading space.
  625.      */
  626.     
  627.     skipSpace:
  628.     c = *src;
  629.     type = CHAR_TYPE(c);
  630.     while (type == TCL_SPACE) {
  631.         src++;
  632.         c = *src;
  633.         type = CHAR_TYPE(c);
  634.     }
  635.     
  636.     /*
  637.      * Handle the normal case (i.e. no leading double-quote or brace).
  638.      */
  639.  
  640.     if (type == TCL_NORMAL) {
  641. normalArg:
  642.         while (1) {
  643.         if (dst == pvPtr->end) {
  644.             /*
  645.              * Target buffer space is about to run out.  Make
  646.              * more space.
  647.              */
  648.     
  649.             pvPtr->next = dst;
  650.             (*pvPtr->expandProc)(pvPtr, 1);
  651.             dst = pvPtr->next;
  652.         }
  653.     
  654.         if (type == TCL_NORMAL) {
  655.             copy:
  656.             *dst = c;
  657.             dst++;
  658.             src++;
  659.         } else if (type == TCL_SPACE) {
  660.             goto wordEnd;
  661.         } else if (type == TCL_DOLLAR) {
  662.             int length;
  663.             char *value;
  664.     
  665.             value = Tcl_ParseVar(interp, src, termPtr);
  666.             if (value == NULL) {
  667.             return TCL_ERROR;
  668.             }
  669.             src = *termPtr;
  670.             length = strlen(value);
  671.             if ((pvPtr->end - dst) <= length) {
  672.             pvPtr->next = dst;
  673.             (*pvPtr->expandProc)(pvPtr, length);
  674.             dst = pvPtr->next;
  675.             }
  676.             strcpy(dst, value);
  677.             dst += length;
  678.         } else if (type == TCL_COMMAND_END) {
  679.             if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
  680.             goto copy;
  681.             }
  682.  
  683.             /*
  684.              * End of command;  simulate a word-end first, so
  685.              * that the end-of-command can be processed as the
  686.              * first thing in a _new word.
  687.              */
  688.  
  689.             goto wordEnd;
  690.         } else if (type == TCL_OPEN_BRACKET) {
  691.             pvPtr->next = dst;
  692.             result = TclParseNestedCmd(interp, src+1, flags, termPtr,
  693.                 pvPtr);
  694.             if (result != TCL_OK) {
  695.             return result;
  696.             }
  697.             src = *termPtr;
  698.             dst = pvPtr->next;
  699.         } else if (type == TCL_BACKSLASH) {
  700.             int numRead;
  701.     
  702.             *dst = Tcl_Backslash(src, &numRead);
  703.             if (*dst != 0) {
  704.             dst++;
  705.             }
  706.             src += numRead;
  707.         } else {
  708.             goto copy;
  709.         }
  710.         c = *src;
  711.         type = CHAR_TYPE(c);
  712.         }
  713.     } else {
  714.     
  715.         /*
  716.          * Check for the end of the command.
  717.          */
  718.     
  719.         if (type == TCL_COMMAND_END) {
  720.         if (flags & TCL_BRACKET_TERM) {
  721.             if (c == '\0') {
  722.             Tcl_SetResult(interp, "missing close-bracket",
  723.                 TCL_STATIC);
  724.             return TCL_ERROR;
  725.             }
  726.         } else {
  727.             if (c == ']') {
  728.             goto normalArg;
  729.             }
  730.         }
  731.         goto done;
  732.         }
  733.     
  734.         /*
  735.          * Now handle the special cases: open braces, double-quotes,
  736.          * and backslash-newline.
  737.          */
  738.  
  739.         pvPtr->next = dst;
  740.         if (type == TCL_QUOTE) {
  741.             result = TclParseQuotes(interp, src+1, '"', flags, termPtr, pvPtr);
  742.             }
  743.         else if (type == TCL_OPEN_BRACE) {
  744.             result = TclParseBraces(interp, src+1, termPtr, pvPtr);
  745.             }
  746.         else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
  747.             src += 2;
  748.             goto skipSpace;
  749.             }
  750.         else {
  751.             goto normalArg;
  752.             }
  753.         
  754.         if (result != TCL_OK) {
  755.             return result;
  756.             }
  757.     
  758.         /*
  759.          * Back from quotes or braces;  make sure that the terminating
  760.          * character was the end of the word.  Have to be careful here
  761.          * to handle continuation lines (i.e. lines ending in backslash).
  762.          */
  763.     
  764.         c = **termPtr;
  765.         if ((c == '\\') && ((*termPtr)[1] == '\n')) {
  766.         c = (*termPtr)[2];
  767.         }
  768.         type = CHAR_TYPE(c);
  769.         if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
  770.         if (*src == '"') {
  771.             Tcl_SetResult(interp, "extra characters after close-quote",
  772.                 TCL_STATIC);
  773.         } else {
  774.             Tcl_SetResult(interp, "extra characters after close-brace",
  775.                 TCL_STATIC);
  776.         }
  777.         return TCL_ERROR;
  778.         }
  779.         src = *termPtr;
  780.         dst = pvPtr->next;
  781.  
  782.     }
  783.  
  784.     /*
  785.      * We're at the end of a word, so add a null terminator.  Then
  786.      * see if the buffer was re-allocated during this word.  If so,
  787.      * update all of the argv pointers.
  788.      */
  789.  
  790.     wordEnd:
  791.     *dst = '\0';
  792.     dst++;
  793.     if (oldBuffer != pvPtr->buffer) {
  794.         int i;
  795.  
  796.         for (i = 0; i <= argc; i++) {
  797.         argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
  798.         }
  799.         oldBuffer = pvPtr->buffer;
  800.     }
  801.     }
  802.  
  803.     done:
  804.     pvPtr->next = dst;
  805.     *termPtr = src;
  806.     *argcPtr = argc;
  807.     return TCL_OK;
  808. }
  809.  
  810. /*
  811.  *--------------------------------------------------------------
  812.  *
  813.  * TclExpandParseValue --
  814.  *
  815.  *    This procedure is commonly used as the value of the
  816.  *    expandProc in a ParseValue.  It uses malloc to allocate
  817.  *    more space for the result of a parse.
  818.  *
  819.  * Results:
  820.  *    The buffer space in *pvPtr is reallocated to something
  821.  *    larger, and if pvPtr->clientData is non-zero the old
  822.  *    buffer is freed.  Information is copied from the old
  823.  *    buffer to the _new one.
  824.  *
  825.  * Side effects:
  826.  *    None.
  827.  *
  828.  *--------------------------------------------------------------
  829.  */
  830.  
  831. void
  832. TclExpandParseValue(pvPtr, needed)
  833.     register ParseValue *pvPtr;        /* Information about buffer that
  834.                      * must be expanded.  If the clientData
  835.                      * in the structure is non-zero, it
  836.                      * means that the current buffer is
  837.                      * dynamically allocated. */
  838.     int needed;                /* Minimum amount of additional space
  839.                      * to allocate. */
  840. {
  841.     int newSpace;
  842.     char *_new;
  843.  
  844.     /*
  845.      * Either double the size of the buffer or add enough _new space
  846.      * to meet the demand, whichever produces a larger _new buffer.
  847.      */
  848.  
  849.     newSpace = (pvPtr->end - pvPtr->buffer) + 1;
  850.     if (newSpace < needed) {
  851.     newSpace += needed;
  852.     } else {
  853.     newSpace += newSpace;
  854.     }
  855.     _new = (char *) ckalloc((unsigned) newSpace);
  856.  
  857.     /*
  858.      * Copy from old buffer to _new, free old buffer if needed, and
  859.      * mark _new buffer as malloc-ed.
  860.      */
  861.  
  862.     memcpy((VOID *) _new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer);
  863.     pvPtr->next = _new + (pvPtr->next - pvPtr->buffer);
  864.     if (pvPtr->clientData != 0) {
  865.     ckfree(pvPtr->buffer);
  866.     }
  867.     pvPtr->buffer = _new;
  868.     pvPtr->end = _new + newSpace - 1;
  869.     pvPtr->clientData = (ClientData) 1;
  870. }
  871.  
  872. /*
  873.  *----------------------------------------------------------------------
  874.  *
  875.  * TclWordEnd --
  876.  *
  877.  *    Given a pointer into a Tcl command, find the end of the next
  878.  *    word of the command.
  879.  *
  880.  * Results:
  881.  *    The return value is a pointer to the character just after the
  882.  *    last one that's part of the word pointed to by "start".  This
  883.  *    may be the address of the NULL character at the end of the
  884.  *    string.
  885.  *
  886.  * Side effects:
  887.  *    None.
  888.  *
  889.  *----------------------------------------------------------------------
  890.  */
  891.  
  892. char *
  893. TclWordEnd(start, nested)
  894.     char *start;        /* Beginning of a word of a Tcl command. */
  895.     int nested;            /* Zero means this is a top-level command.
  896.                  * One means this is a nested command (close
  897.                  * brace is a word terminator). */
  898. {
  899.     register char *p;
  900.     int count;
  901.  
  902.     p = start;
  903.     while (isspace(*p)) {
  904.     p++;
  905.     }
  906.  
  907.     /*
  908.      * Handle words beginning with a double-quote or a brace.
  909.      */
  910.  
  911.     if (*p == '"') {
  912.     p = QuoteEnd(p+1, '"');
  913.     } else if (*p == '{') {
  914.     int braces = 1;
  915.     while (braces != 0) {
  916.         p++;
  917.         while (*p == '\\') {
  918.         (void) Tcl_Backslash(p, &count);
  919.         p += count;
  920.         }
  921.         if (*p == '}') {
  922.         braces--;
  923.         } else if (*p == '{') {
  924.         braces++;
  925.         } else if (*p == 0) {
  926.         return p;
  927.         }
  928.     }
  929.     }
  930.  
  931.     /*
  932.      * Handle words that don't start with a brace or double-quote.
  933.      * This code is also invoked if the word starts with a brace or
  934.      * double-quote and there is garbage after the closing brace or
  935.      * quote.  This is an error as far as Tcl_Eval is concerned, but
  936.      * for here the garbage is treated as part of the word.
  937.      */
  938.  
  939.     while (*p != 0) {
  940.     if (*p == '[') {
  941.         p++;
  942.         while ((*p != ']') && (*p != 0)) {
  943.         p = TclWordEnd(p, 1);
  944.         }
  945.         if (*p == ']') {
  946.         p++;
  947.         }
  948.     } else if (*p == '\\') {
  949.         (void) Tcl_Backslash(p, &count);
  950.         p += count;
  951.     } else if (*p == '$') {
  952.         p = VarNameEnd(p);
  953.     } else if (*p == ';') {
  954.         /*
  955.          * Note:  semi-colon terminates a word
  956.          * and also counts as a word by itself.
  957.          */
  958.  
  959.         if (p == start) {
  960.         p++;
  961.         }
  962.         break;
  963.     } else if (isspace(*p)) {
  964.         break;
  965.     } else if ((*p == ']') && nested) {
  966.         break;
  967.     } else {
  968.         p++;
  969.     }
  970.     }
  971.     return p;
  972. }
  973.  
  974. /*
  975.  *----------------------------------------------------------------------
  976.  *
  977.  * QuoteEnd --
  978.  *
  979.  *    Given a pointer to a string that obeys the parsing conventions
  980.  *    for quoted things in Tcl, find the end of that quoted thing.
  981.  *    The actual thing may be a quoted argument or a parenthesized
  982.  *    index name.
  983.  *
  984.  * Results:
  985.  *    The return value is a pointer to the character just after the
  986.  *    last one that is part of the quoted string.
  987.  *
  988.  * Side effects:
  989.  *    None.
  990.  *
  991.  *----------------------------------------------------------------------
  992.  */
  993.  
  994. static char *
  995. QuoteEnd(string, term)
  996.     char *string;        /* Pointer to character just after opening
  997.                  * "quote". */
  998.     int term;            /* This character will terminate the
  999.                  * quoted string (e.g. '"' or ')'). */
  1000. {
  1001.     register char *p = string;
  1002.     int count;
  1003.  
  1004.     while ((*p != 0) && (*p != term)) {
  1005.     if (*p == '\\') {
  1006.         (void) Tcl_Backslash(p, &count);
  1007.         p += count;
  1008.     } else if (*p == '[') {
  1009.         p++;
  1010.         while ((*p != ']') && (*p != 0)) {
  1011.         p = TclWordEnd(p, 1);
  1012.         }
  1013.         if (*p == ']') {
  1014.         p++;
  1015.         }
  1016.     } else if (*p == '$') {
  1017.         p = VarNameEnd(p);
  1018.     } else {
  1019.         p++;
  1020.     }
  1021.     }
  1022.     return p;
  1023. }
  1024.  
  1025. /*
  1026.  *----------------------------------------------------------------------
  1027.  *
  1028.  * VarNameEnd --
  1029.  *
  1030.  *    Given a pointer to a variable reference using $-notation, find
  1031.  *    the end of the variable name spec.
  1032.  *
  1033.  * Results:
  1034.  *    The return value is a pointer to the character just after the
  1035.  *    last one that is part of the variable name.
  1036.  *
  1037.  * Side effects:
  1038.  *    None.
  1039.  *
  1040.  *----------------------------------------------------------------------
  1041.  */
  1042.  
  1043. static char *
  1044. VarNameEnd(string)
  1045.     char *string;        /* Pointer to dollar-sign character. */
  1046. {
  1047.     register char *p = string+1;
  1048.  
  1049.     if (*p == '{') {
  1050.     do {
  1051.         p++;
  1052.     } while ((*p != '}') && (*p != 0));
  1053.     } else {
  1054.     while (isalnum(*p) || (*p == '_')) {
  1055.         p++;
  1056.     }
  1057.     if ((*p == '(') && (p != string+1)) {
  1058.         p = QuoteEnd(p+1, ')');
  1059.     }
  1060.     }
  1061.     return p;
  1062. }
  1063.  
  1064. /*
  1065.  *----------------------------------------------------------------------
  1066.  *
  1067.  * Tcl_ParseVar --
  1068.  *
  1069.  *    Given a string starting with a $ sign, parse off a variable
  1070.  *    name and return its value.
  1071.  *
  1072.  * Results:
  1073.  *    The return value is the contents of the variable given by
  1074.  *    the leading characters of string.  If termPtr isn't NULL,
  1075.  *    *termPtr gets filled in with the address of the character
  1076.  *    just after the last one in the variable specifier.  If the
  1077.  *    variable doesn't exist, then the return value is NULL and
  1078.  *    an error message will be left in interp->result.
  1079.  *
  1080.  * Side effects:
  1081.  *    None.
  1082.  *
  1083.  *----------------------------------------------------------------------
  1084.  */
  1085.  
  1086. char *
  1087. Tcl_ParseVar(interp, string, termPtr)
  1088.     Tcl_Interp *interp;            /* Context for looking up variable. */
  1089.     register char *string;        /* String containing variable name.
  1090.                      * First character must be "$". */
  1091.     char **termPtr;            /* If non-NULL, points to word to fill
  1092.                      * in with character just after last
  1093.                      * one in the variable specifier. */
  1094.  
  1095. {
  1096.     char *name1, *name1End, c, *result;
  1097.     register char *name2;
  1098. #define NUM_CHARS 200
  1099.     char copyStorage[NUM_CHARS];
  1100.     ParseValue pv;
  1101.  
  1102.     /*
  1103.      * There are three cases:
  1104.      * 1. The $ sign is followed by an open curly brace.  Then the variable
  1105.      *    name is everything up to the next close curly brace, and the
  1106.      *    variable is a scalar variable.
  1107.      * 2. The $ sign is not followed by an open curly brace.  Then the
  1108.      *    variable name is everything up to the next character that isn't
  1109.      *    a letter, digit, or underscore.  If the following character is an
  1110.      *    open parenthesis, then the information between parentheses is
  1111.      *    the array element name, which can include any of the substitutions
  1112.      *    permissible between quotes.
  1113.      * 3. The $ sign is followed by something that isn't a letter, digit,
  1114.      *    or underscore:  in this case, there is no variable name, and "$"
  1115.      *    is returned.
  1116.      */
  1117.  
  1118.     name2 = NULL;
  1119.     string++;
  1120.     if (*string == '{') {
  1121.     string++;
  1122.     name1 = string;
  1123.     while (*string != '}') {
  1124.         if (*string == 0) {
  1125.         Tcl_SetResult(interp, "missing close-brace for variable name",
  1126.             TCL_STATIC);
  1127.         return NULL;
  1128.         }
  1129.         string++;
  1130.     }
  1131.     name1End = string;
  1132.     string++;
  1133.     } else {
  1134.     name1 = string;
  1135.     while (isalnum(*string) || (*string == '_')) {
  1136.         string++;
  1137.     }
  1138.     if (string == name1) {
  1139.         if (termPtr != 0) {
  1140.         *termPtr = string;
  1141.         }
  1142.         return "$";
  1143.     }
  1144.     name1End = string;
  1145.     if (*string == '(') {
  1146.         char *end;
  1147.  
  1148.         /*
  1149.          * Perform substitutions on the array element name, just as
  1150.          * is done for quotes.
  1151.          */
  1152.  
  1153.         pv.buffer = pv.next = copyStorage;
  1154.         pv.end = copyStorage + NUM_CHARS - 1;
  1155.         pv.expandProc = TclExpandParseValue;
  1156.         pv.clientData = (ClientData) NULL;
  1157.         if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
  1158.             != TCL_OK) {
  1159.         char msg[100];
  1160.         sprintf(msg, "\n    (parsing index for array \"%.*s\")",
  1161.             string-name1, name1);
  1162.         Tcl_AddErrorInfo(interp, msg);
  1163.         result = NULL;
  1164.         name2 = pv.buffer;
  1165.         goto done;
  1166.         }
  1167.         string = end;
  1168.         name2 = pv.buffer;
  1169.     }
  1170.     }
  1171.     if (termPtr != 0) {
  1172.     *termPtr = string;
  1173.     }
  1174.  
  1175.     c = *name1End;
  1176.     *name1End = 0;
  1177.     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
  1178.     *name1End = c;
  1179.  
  1180.     done:
  1181.     if ((name2 != NULL) && (pv.buffer != copyStorage)) {
  1182.     ckfree(pv.buffer);
  1183.     }
  1184.     return result;
  1185. }
  1186.